home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok20.lha / ComplexLib / txt / MathLibExt.mod < prev    next >
Text File  |  1993-08-15  |  4KB  |  184 lines
  1.  
  2.  
  3. (*********************************************************************
  4.  
  5.     :Program.       MathLibExt.mod
  6.     :Author.        Gary Struhlik  
  7.     :Address.    -
  8.     :Phone.      -
  9.     :shortcut.      [gs]
  10.     :Version.       1.0   
  11.     :Date.          06.10.1988
  12.     :Copyright.  PD
  13.     :Language.      Modula-II
  14.     :Translator. M2Amiga
  15.     :Imports.     -
  16.     :UpDate.     -
  17.     :Contents.     Zusätzliche mathematische Funktionen
  18.     :Remark.     Für den Amiga Modula-2 Klub / Stuttgart
  19.     :Remark.     Am 01.01.1989 mit M2Amiga 3.2d neu kompiliert
  20.  
  21. **********************************************************************)
  22.  
  23. IMPLEMENTATION MODULE MathLibExt; (* für Datentyp REAL *)
  24.  
  25. FROM Mathlib0 IMPORT sin,cos,ln,exp,sqrt,arctan;
  26.  
  27. PROCEDURE round ( x : REAL ) : LONGINT;
  28. BEGIN
  29.    IF    x >= 0.0 THEN RETURN TRUNC( x + 0.5 )
  30.    ELSE  RETURN TRUNC( x - 0.5 )
  31.    END (* IF *)
  32. END round;        
  33.  
  34. PROCEDURE sqr ( x : REAL ) : REAL;
  35. BEGIN
  36.    RETURN x*x
  37. END sqr;       
  38.  
  39. PROCEDURE tan ( x : REAL ) : REAL;
  40. BEGIN
  41.    RETURN sin(x)/cos(x)
  42. END tan;
  43.  
  44. PROCEDURE arcsin ( x : REAL ) : REAL;
  45. BEGIN
  46.    IF x=1.0 THEN RETURN pi/2.0
  47.     ELSIF x=-1.0 THEN RETURN -pi/2.0
  48.    ELSE
  49.     RETURN arctan(x/sqrt(1.0-x*x))
  50.    END
  51. END arcsin;
  52.  
  53. PROCEDURE arccos ( x : REAL ) : REAL;
  54. BEGIN
  55.    IF x=1.0 THEN RETURN 0.0
  56.     ELSIF x=-1.0 THEN RETURN pi
  57.    ELSE
  58.     RETURN pi/2.0-arcsin(x)
  59.    END
  60. END arccos;
  61.  
  62. PROCEDURE sinh ( x : REAL ) : REAL;
  63. BEGIN
  64.    RETURN 0.5*(exp(x)-exp(-x))
  65. END sinh;
  66.  
  67. PROCEDURE cosh ( x : REAL ) : REAL;
  68. BEGIN
  69.    RETURN 0.5*(exp(x)+exp(-x))
  70. END cosh;
  71.  
  72. PROCEDURE tanh ( x : REAL ) : REAL;
  73. BEGIN
  74.    RETURN sinh(x)/cosh(x)
  75. END tanh;
  76.  
  77. PROCEDURE log ( x : REAL ) : REAL;
  78. BEGIN
  79.    RETURN ln(x)/ln10
  80. END log;
  81.  
  82. PROCEDURE PwrOfTen ( x : REAL ) : REAL;
  83. BEGIN
  84.    RETURN exp(x*ln10)
  85. END PwrOfTen;
  86.  
  87. PROCEDURE lb ( x : REAL ) : REAL;
  88. BEGIN
  89.    RETURN ln(x)/ln2
  90. END lb;
  91.  
  92. PROCEDURE PwrOfTwo ( x : REAL ) : REAL;
  93. BEGIN
  94.    RETURN exp(x*ln2)
  95. END PwrOfTwo;
  96.  
  97. PROCEDURE arsinh ( x : REAL ) : REAL;
  98. BEGIN
  99.    RETURN ln( x + sqrt( x*x + 1.0))
  100. END arsinh;
  101.  
  102. PROCEDURE arcosh ( x : REAL ) : REAL;
  103. BEGIN
  104.    IF (x > 1.0) THEN RETURN ln( x + sqrt( x*x - 1.0))  (* für x # 1.0  *)
  105.     ELSIF x=1.0 THEN RETURN 0.0
  106.    END (* IF *)
  107. END arcosh;
  108.  
  109. PROCEDURE artanh ( x : REAL ) : REAL;
  110. BEGIN
  111.    RETURN 0.5*ln( (1.0+x)/(1.0-x) )  (* für x # 1.0   *)
  112. END artanh;
  113.  
  114. PROCEDURE power ( x,y : REAL ) : REAL; (* x^y *)
  115. VAR
  116.     wert,n : REAL;
  117.         i      : INTEGER;
  118. BEGIN
  119.    IF (x = 0.0) AND (y = 0.0) THEN
  120.        RETURN 1.0E-38
  121.      ELSIF x = 0.0 THEN
  122.            RETURN 0.0
  123.        ELSIF y = 0.0 THEN
  124.              RETURN 1.0
  125.        ELSIF x > 0.0 THEN
  126.              IF ( y-REAL(TRUNC(y)) <> 0.0 ) THEN
  127.                 RETURN exp(y*ln(x))
  128.              ELSE
  129.                 n:=1.0;
  130.                 FOR i:=1 TO ABS(TRUNC(y)) DO
  131.                    n:=n*x
  132.                 END; (* FOR *)
  133.                 IF y > 0.0 THEN
  134.                    RETURN n
  135.                 ELSE
  136.                    RETURN 1.0/n
  137.                 END (* IF y > 0.0 *)
  138.              END (* IF y-REAL... *)
  139.            ELSE    
  140.          IF (y-REAL(TRUNC(y)) <> 0.0) THEN
  141.                 RETURN 1.0E-38
  142.              ELSE
  143.                 n:=1.0;
  144.                 FOR i:=1 TO ABS(TRUNC(y)) DO
  145.                    n:=n*x
  146.                 END; (* FOR *)
  147.                 IF y > 0.0 THEN 
  148.                    RETURN n
  149.                 ELSE
  150.                    RETURN 1.0/n
  151.                 END
  152.          END
  153.    END
  154. END power;   
  155.                                          
  156. PROCEDURE fact ( x : REAL ) : REAL; (*  Fakultät  *)
  157. VAR
  158.     i : INTEGER;
  159.         fac : REAL;
  160. BEGIN
  161.    fac:=1.0;
  162.    IF (x = 1.0) OR (x = 0.0) THEN
  163.       RETURN 1.0
  164.     ELSIF x < 0.0 THEN
  165.       RETURN 1.0E-38
  166.     ELSE
  167.       FOR i:=2 TO TRUNC(x) DO
  168.           fac:=fac+fac*( REAL(i)-1.0 )   
  169.       END; (* FOR *)
  170.       RETURN fac
  171.    END
  172. END fact;
  173.  
  174. PROCEDURE sgn ( x : REAL ) : REAL;  (*   Vorzeichen -1.0, 0.0 oder +1.0  *)
  175. BEGIN
  176.    IF x = 0.0 THEN
  177.       RETURN 0.0
  178.    ELSE
  179.       RETURN x/ABS(x)
  180.    END (* IF *)
  181. END sgn;
  182.  
  183. END MathLibExt.
  184.